<!doctype html>
<title>CodeMirror: Common Lisp mode</title>
<meta charset="utf-8" />
<link rel=stylesheet href="../../doc/docs.css">
<link rel="stylesheet" href="../../lib/codemirror.css">
<script src="../../lib/codemirror.js"></script>
<script src="commonlisp.js"></script>
<style>
    .CodeMirror {
        background: #f8f8f8;
    }
</style>
<div id=nav>
    <a href="http://codemirror.net">
        <h1>CodeMirror</h1>
        <img id=logo src="../../doc/logo.png">
    </a>
    <ul>
        <li>
            <a href="../../index.html">Home</a>
            <li>
                <a href="../../doc/manual.html">Manual</a>
                <li>
                    <a href="https://github.com/codemirror/codemirror">Code</a>
    </ul>
    <ul>
        <li>
            <a href="../index.html">Language modes</a>
            <li>
                <a class=active href="#">Common Lisp</a>
    </ul>
</div>
<article>
    <h2>Common Lisp mode</h2>
    <form>
        <textarea id="code" name="code">(in-package :cl-postgres) ;; These are used to synthesize reader and writer names for integer ;; reading/writing functions when the amount of bytes and the ;; signedness is known. Both the macro that creates the functions and ;; some macros that
            use them create names this way. (eval-when (:compile-toplevel :load-toplevel :execute) (defun integer-reader-name (bytes signed) (intern (with-standard-io-syntax (format nil "~a~a~a~a" '#:read- (if signed "" '#:u) '#:int bytes)))) (defun integer-writer-name
            (bytes signed) (intern (with-standard-io-syntax (format nil "~a~a~a~a" '#:write- (if signed "" '#:u) '#:int bytes))))) (defmacro integer-reader (bytes) "Create a function to read integers from a binary stream." (let ((bits (* bytes 8))) (labels
            ((return-form (signed) (if signed `(if (logbitp ,(1- bits) result) (dpb result (byte ,(1- bits) 0) -1) result) `result)) (generate-reader (signed) `(defun ,(integer-reader-name bytes signed) (socket) (declare (type stream socket) #.*optimize*)
            ,(if (= bytes 1) `(let ((result (the (unsigned-byte 8) (read-byte socket)))) (declare (type (unsigned-byte 8) result)) ,(return-form signed)) `(let ((result 0)) (declare (type (unsigned-byte ,bits) result)) ,@(loop :for byte :from (1- bytes)
            :downto 0 :collect `(setf (ldb (byte 8 ,(* 8 byte)) result) (the (unsigned-byte 8) (read-byte socket)))) ,(return-form signed)))))) `(progn ;; This causes weird errors on SBCL in some circumstances. Disabled for now. ;; (declaim (inline ,(integer-reader-name
            bytes t) ;; ,(integer-reader-name bytes nil))) (declaim (ftype (function (t) (signed-byte ,bits)) ,(integer-reader-name bytes t))) ,(generate-reader t) (declaim (ftype (function (t) (unsigned-byte ,bits)) ,(integer-reader-name bytes nil)))
            ,(generate-reader nil))))) (defmacro integer-writer (bytes) "Create a function to write integers to a binary stream." (let ((bits (* 8 bytes))) `(progn (declaim (inline ,(integer-writer-name bytes t) ,(integer-writer-name bytes nil))) (defun
            ,(integer-writer-name bytes nil) (socket value) (declare (type stream socket) (type (unsigned-byte ,bits) value) #.*optimize*) ,@(if (= bytes 1) `((write-byte value socket)) (loop :for byte :from (1- bytes) :downto 0 :collect `(write-byte
            (ldb (byte 8 ,(* byte 8)) value) socket))) (values)) (defun ,(integer-writer-name bytes t) (socket value) (declare (type stream socket) (type (signed-byte ,bits) value) #.*optimize*) ,@(if (= bytes 1) `((write-byte (ldb (byte 8 0) value) socket))
            (loop :for byte :from (1- bytes) :downto 0 :collect `(write-byte (ldb (byte 8 ,(* byte 8)) value) socket))) (values))))) ;; All the instances of the above that we need. (integer-reader 1) (integer-reader 2) (integer-reader 4) (integer-reader
            8) (integer-writer 1) (integer-writer 2) (integer-writer 4) (defun write-bytes (socket bytes) "Write a byte-array to a stream." (declare (type stream socket) (type (simple-array (unsigned-byte 8)) bytes) #.*optimize*) (write-sequence bytes
            socket)) (defun write-str (socket string) "Write a null-terminated string to a stream \(encoding it when UTF-8 support is enabled.)." (declare (type stream socket) (type string string) #.*optimize*) (enc-write-string string socket) (write-uint1
            socket 0)) (declaim (ftype (function (t unsigned-byte) (simple-array (unsigned-byte 8) (*))) read-bytes)) (defun read-bytes (socket length) "Read a byte array of the given length from a stream." (declare (type stream socket) (type fixnum length)
            #.*optimize*) (let ((result (make-array length :element-type '(unsigned-byte 8)))) (read-sequence result socket) result)) (declaim (ftype (function (t) string) read-str)) (defun read-str (socket) "Read a null-terminated string from a stream.
            Takes care of encoding when UTF-8 support is enabled." (declare (type stream socket) #.*optimize*) (enc-read-string socket :null-terminated t)) (defun skip-bytes (socket length) "Skip a given number of bytes in a binary stream." (declare (type
            stream socket) (type (unsigned-byte 32) length) #.*optimize*) (dotimes (i length) (read-byte socket))) (defun skip-str (socket) "Skip a null-terminated string." (declare (type stream socket) #.*optimize*) (loop :for char :of-type fixnum =
            (read-byte socket) :until (zerop char))) (defun ensure-socket-is-closed (socket &amp;key abort) (when (open-stream-p socket) (handler-case (close socket :abort abort) (error (error) (warn "Ignoring the error which happened while trying to
            close PostgreSQL socket: ~A" error))))) </textarea>
    </form>
    <script>
        var editor = CodeMirror.fromTextArea(document.getElementById("code"),
        {
            lineNumbers: true
        });
    </script>
    <p>
        <strong>MIME types defined:</strong> <code>text/x-common-lisp</code>.</p>
</article>